Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mtstacks.i

Modula Implementation | 1997-10-26 | 5.3 KB | 167 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
 *               ÿ         ÿ            ÿ    ÿ          ÿ               *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
 * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
 * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
 * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
 * Einverst„ndnisserkl„rung des Autors.                                 *
 *                                                                      *
 * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
 * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
 * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
 * widerrufen.                                                          *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtStacks;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;








FROM Storage IMPORT ALLOCATE, DEALLOCATE;




FROM SYSTEM     IMPORT  ADDRESS, ADR, TSIZE;

CONST   cMax =          07FFFH;

TYPE    INFO =          POINTER TO ARRAY [0..cMax] OF LOC;

TYPE    ENTRY =         POINTER TO Entry;
        Entry =         RECORD
                         addr: INFO;
                         size: CARDINAL;
                         next: ENTRY;
                        END;

TYPE    STACK =         POINTER TO Stack;
        Stack =         RECORD
                         start: ENTRY;
                         entry: lCARDINAL;
                        END;

PROCEDURE Copy (from, to: INFO; size: CARDINAL);
VAR c: CARDINAL;
BEGIN
 FOR c:= 0 TO size DO to^[c]:= from^[c]; END;
END Copy;

PROCEDURE NewStack (VAR stack: STACK): BOOLEAN;
BEGIN
 ALLOCATE (stack,  TSIZE(Stack));
 IF stack = NIL THEN RETURN FALSE; END;
 stack^.start:= NIL;
 stack^.entry:= LONG (0);
 RETURN TRUE;
END NewStack;

PROCEDURE DisposeStack (VAR stack: STACK);
VAR p: ENTRY;
BEGIN
 IF stack # NIL THEN
  WITH stack^ DO
   WHILE start # NIL DO
    p:= start^.next;
    DEALLOCATE (start^.addr, 0);
    DEALLOCATE (start, 0);
    start:= p;
   END;
  END;
  DEALLOCATE (stack, 0);
 END;
 stack:= NIL;
END DisposeStack;

PROCEDURE StackEmpty (stack: STACK): BOOLEAN;
BEGIN
 IF stack = NIL THEN  RETURN TRUE;  END;
 RETURN stack^.start = NIL;
END StackEmpty;

PROCEDURE StackEntries (stack: STACK): lCARDINAL;
BEGIN
 IF stack = NIL THEN  RETURN LONG (0);
                ELSE  RETURN stack^.entry;
 END;
END StackEntries;

PROCEDURE Push (stack: STACK; info: ARRAY OF LOC): BOOLEAN;
VAR p: ENTRY;
BEGIN
 IF stack = NIL THEN  RETURN FALSE;  END;
 ALLOCATE (p,  TSIZE(Entry));
 IF p = NIL THEN  RETURN FALSE;  END;
 p^.size:= HIGH (info);
 ALLOCATE (p^.addr,  LONG(p^.size));
 IF p^.addr = NIL THEN  RETURN FALSE;  END;
 Copy (ADR(info), p^.addr, p^.size);
 p^.next:= stack^.start;
 stack^.start:= p;
 INC (stack^.entry);
 RETURN TRUE;
END Push;

PROCEDURE Pop (stack: STACK; VAR info: ARRAY OF LOC): BOOLEAN;
VAR p: ENTRY;
BEGIN
 IF stack = NIL THEN  RETURN FALSE;  END;
 WITH stack^ DO
  IF start = NIL THEN
   RETURN FALSE;
  ELSE
   IF HIGH(info) < start^.size THEN  RETURN FALSE;  END;
   Copy (start^.addr, ADR(info), start^.size);
   p:= start^.next;
   DEALLOCATE (start^.addr, 0);
   DEALLOCATE (start, 0);
   start:= p;
  END;
 END;
 DEC (stack^.entry);
 RETURN TRUE;
END Pop;

END mtStacks.